home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / tcltk / tk8.4 / text.tcl < prev    next >
Text File  |  2009-04-29  |  31KB  |  1,157 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # RCS: @(#) $Id: text.tcl,v 1.24.2.9 2006/09/10 17:07:36 das Exp $
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. # Copyright (c) 1998 by Scriptics Corporation.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #-------------------------------------------------------------------------
  17. # Elements of ::tk::Priv that are used in this file:
  18. #
  19. # afterId -        If non-null, it means that auto-scanning is underway
  20. #            and it gives the "after" id for the next auto-scan
  21. #            command to be executed.
  22. # char -        Character position on the line;  kept in order
  23. #            to allow moving up or down past short lines while
  24. #            still remembering the desired position.
  25. # mouseMoved -        Non-zero means the mouse has moved a significant
  26. #            amount since the button went down (so, for example,
  27. #            start dragging out a selection).
  28. # prevPos -        Used when moving up or down lines via the keyboard.
  29. #            Keeps track of the previous insert position, so
  30. #            we can distinguish a series of ups and downs, all
  31. #            in a row, from a new up or down.
  32. # selectMode -        The style of selection currently underway:
  33. #            char, word, or line.
  34. # x, y -        Last known mouse coordinates for scanning
  35. #            and auto-scanning.
  36. #-------------------------------------------------------------------------
  37.  
  38. #-------------------------------------------------------------------------
  39. # The code below creates the default class bindings for text widgets.
  40. #-------------------------------------------------------------------------
  41.  
  42. # Standard Motif bindings:
  43.  
  44. bind Text <1> {
  45.     tk::TextButton1 %W %x %y
  46.     %W tag remove sel 0.0 end
  47. }
  48. bind Text <B1-Motion> {
  49.     set tk::Priv(x) %x
  50.     set tk::Priv(y) %y
  51.     tk::TextSelectTo %W %x %y
  52. }
  53. bind Text <Double-1> {
  54.     set tk::Priv(selectMode) word
  55.     tk::TextSelectTo %W %x %y
  56.     catch {%W mark set insert sel.last}
  57. }
  58. bind Text <Triple-1> {
  59.     set tk::Priv(selectMode) line
  60.     tk::TextSelectTo %W %x %y
  61.     catch {%W mark set insert sel.last}
  62. }
  63. bind Text <Shift-1> {
  64.     tk::TextResetAnchor %W @%x,%y
  65.     set tk::Priv(selectMode) char
  66.     tk::TextSelectTo %W %x %y
  67. }
  68. bind Text <Double-Shift-1>    {
  69.     set tk::Priv(selectMode) word
  70.     tk::TextSelectTo %W %x %y 1
  71. }
  72. bind Text <Triple-Shift-1>    {
  73.     set tk::Priv(selectMode) line
  74.     tk::TextSelectTo %W %x %y
  75. }
  76. bind Text <B1-Leave> {
  77.     set tk::Priv(x) %x
  78.     set tk::Priv(y) %y
  79.     tk::TextAutoScan %W
  80. }
  81. bind Text <B1-Enter> {
  82.     tk::CancelRepeat
  83. }
  84. bind Text <ButtonRelease-1> {
  85.     tk::CancelRepeat
  86. }
  87. bind Text <Control-1> {
  88.     %W mark set insert @%x,%y
  89. }
  90. bind Text <Left> {
  91.     tk::TextSetCursor %W insert-1c
  92. }
  93. bind Text <Right> {
  94.     tk::TextSetCursor %W insert+1c
  95. }
  96. bind Text <Up> {
  97.     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  98. }
  99. bind Text <Down> {
  100.     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  101. }
  102. bind Text <Shift-Left> {
  103.     tk::TextKeySelect %W [%W index {insert - 1c}]
  104. }
  105. bind Text <Shift-Right> {
  106.     tk::TextKeySelect %W [%W index {insert + 1c}]
  107. }
  108. bind Text <Shift-Up> {
  109.     tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
  110. }
  111. bind Text <Shift-Down> {
  112.     tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
  113. }
  114. bind Text <Control-Left> {
  115.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  116. }
  117. bind Text <Control-Right> {
  118.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  119. }
  120. bind Text <Control-Up> {
  121.     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  122. }
  123. bind Text <Control-Down> {
  124.     tk::TextSetCursor %W [tk::TextNextPara %W insert]
  125. }
  126. bind Text <Shift-Control-Left> {
  127.     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  128. }
  129. bind Text <Shift-Control-Right> {
  130.     tk::TextKeySelect %W [tk::TextNextWord %W insert]
  131. }
  132. bind Text <Shift-Control-Up> {
  133.     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  134. }
  135. bind Text <Shift-Control-Down> {
  136.     tk::TextKeySelect %W [tk::TextNextPara %W insert]
  137. }
  138. bind Text <Prior> {
  139.     tk::TextSetCursor %W [tk::TextScrollPages %W -1]
  140. }
  141. bind Text <Shift-Prior> {
  142.     tk::TextKeySelect %W [tk::TextScrollPages %W -1]
  143. }
  144. bind Text <Next> {
  145.     tk::TextSetCursor %W [tk::TextScrollPages %W 1]
  146. }
  147. bind Text <Shift-Next> {
  148.     tk::TextKeySelect %W [tk::TextScrollPages %W 1]
  149. }
  150. bind Text <Control-Prior> {
  151.     %W xview scroll -1 page
  152. }
  153. bind Text <Control-Next> {
  154.     %W xview scroll 1 page
  155. }
  156.  
  157. bind Text <Home> {
  158.     tk::TextSetCursor %W {insert linestart}
  159. }
  160. bind Text <Shift-Home> {
  161.     tk::TextKeySelect %W {insert linestart}
  162. }
  163. bind Text <End> {
  164.     tk::TextSetCursor %W {insert lineend}
  165. }
  166. bind Text <Shift-End> {
  167.     tk::TextKeySelect %W {insert lineend}
  168. }
  169. bind Text <Control-Home> {
  170.     tk::TextSetCursor %W 1.0
  171. }
  172. bind Text <Control-Shift-Home> {
  173.     tk::TextKeySelect %W 1.0
  174. }
  175. bind Text <Control-End> {
  176.     tk::TextSetCursor %W {end - 1 char}
  177. }
  178. bind Text <Control-Shift-End> {
  179.     tk::TextKeySelect %W {end - 1 char}
  180. }
  181.  
  182. bind Text <Tab> {
  183.     if { [%W cget -state] eq "normal" } {
  184.     tk::TextInsert %W \t
  185.     focus %W
  186.     break
  187.     }
  188. }
  189. bind Text <Shift-Tab> {
  190.     # Needed only to keep <Tab> binding from triggering;  doesn't
  191.     # have to actually do anything.
  192.     break
  193. }
  194. bind Text <Control-Tab> {
  195.     focus [tk_focusNext %W]
  196. }
  197. bind Text <Control-Shift-Tab> {
  198.     focus [tk_focusPrev %W]
  199. }
  200. bind Text <Control-i> {
  201.     tk::TextInsert %W \t
  202. }
  203. bind Text <Return> {
  204.     tk::TextInsert %W \n
  205.     if {[%W cget -autoseparators]} {%W edit separator}
  206. }
  207. bind Text <Delete> {
  208.     if {[%W tag nextrange sel 1.0 end] ne ""} {
  209.     %W delete sel.first sel.last
  210.     } else {
  211.     %W delete insert
  212.     %W see insert
  213.     }
  214. }
  215. bind Text <BackSpace> {
  216.     if {[%W tag nextrange sel 1.0 end] ne ""} {
  217.     %W delete sel.first sel.last
  218.     } elseif {[%W compare insert != 1.0]} {
  219.     %W delete insert-1c
  220.     %W see insert
  221.     }
  222. }
  223.  
  224. bind Text <Control-space> {
  225.     %W mark set anchor insert
  226. }
  227. bind Text <Select> {
  228.     %W mark set anchor insert
  229. }
  230. bind Text <Control-Shift-space> {
  231.     set tk::Priv(selectMode) char
  232.     tk::TextKeyExtend %W insert
  233. }
  234. bind Text <Shift-Select> {
  235.     set tk::Priv(selectMode) char
  236.     tk::TextKeyExtend %W insert
  237. }
  238. bind Text <Control-slash> {
  239.     %W tag add sel 1.0 end
  240. }
  241. bind Text <Control-backslash> {
  242.     %W tag remove sel 1.0 end
  243. }
  244. bind Text <<Cut>> {
  245.     tk_textCut %W
  246. }
  247. bind Text <<Copy>> {
  248.     tk_textCopy %W
  249. }
  250. bind Text <<Paste>> {
  251.     tk_textPaste %W
  252. }
  253. bind Text <<Clear>> {
  254.     catch {%W delete sel.first sel.last}
  255. }
  256. bind Text <<PasteSelection>> {
  257.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  258.     || !$tk::Priv(mouseMoved)} {
  259.     tk::TextPasteSelection %W %x %y
  260.     }
  261. }
  262. bind Text <Insert> {
  263.     catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
  264. }
  265. bind Text <KeyPress> {
  266.     tk::TextInsert %W %A
  267. }
  268.  
  269. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  270. # Otherwise, if a widget binding for one of these is defined, the
  271. # <KeyPress> class binding will also fire and insert the character,
  272. # which is wrong.  Ditto for <Escape>.
  273.  
  274. bind Text <Alt-KeyPress> {# nothing }
  275. bind Text <Meta-KeyPress> {# nothing}
  276. bind Text <Control-KeyPress> {# nothing}
  277. bind Text <Escape> {# nothing}
  278. bind Text <KP_Enter> {# nothing}
  279.  
  280. if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
  281.     bind Text <Command-KeyPress> {# nothing}
  282. }
  283.  
  284. # Additional emacs-like bindings:
  285.  
  286. bind Text <Control-a> {
  287.     if {!$tk_strictMotif} {
  288.     tk::TextSetCursor %W {insert linestart}
  289.     }
  290. }
  291. bind Text <Control-b> {
  292.     if {!$tk_strictMotif} {
  293.     tk::TextSetCursor %W insert-1c
  294.     }
  295. }
  296. bind Text <Control-d> {
  297.     if {!$tk_strictMotif} {
  298.     %W delete insert
  299.     }
  300. }
  301. bind Text <Control-e> {
  302.     if {!$tk_strictMotif} {
  303.     tk::TextSetCursor %W {insert lineend}
  304.     }
  305. }
  306. bind Text <Control-f> {
  307.     if {!$tk_strictMotif} {
  308.     tk::TextSetCursor %W insert+1c
  309.     }
  310. }
  311. bind Text <Control-k> {
  312.     if {!$tk_strictMotif} {
  313.     if {[%W compare insert == {insert lineend}]} {
  314.         %W delete insert
  315.     } else {
  316.         %W delete insert {insert lineend}
  317.     }
  318.     }
  319. }
  320. bind Text <Control-n> {
  321.     if {!$tk_strictMotif} {
  322.     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  323.     }
  324. }
  325. bind Text <Control-o> {
  326.     if {!$tk_strictMotif} {
  327.     %W insert insert \n
  328.     %W mark set insert insert-1c
  329.     }
  330. }
  331. bind Text <Control-p> {
  332.     if {!$tk_strictMotif} {
  333.     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  334.     }
  335. }
  336. bind Text <Control-t> {
  337.     if {!$tk_strictMotif} {
  338.     tk::TextTranspose %W
  339.     }
  340. }
  341.  
  342. bind Text <<Undo>> {
  343.     catch { %W edit undo }
  344. }
  345.  
  346. bind Text <<Redo>> {
  347.     catch { %W edit redo }
  348. }
  349.  
  350. if {$tcl_platform(platform) ne "windows"} {
  351. bind Text <Control-v> {
  352.     if {!$tk_strictMotif} {
  353.     tk::TextScrollPages %W 1
  354.     }
  355. }
  356. }
  357.  
  358. bind Text <Meta-b> {
  359.     if {!$tk_strictMotif} {
  360.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  361.     }
  362. }
  363. bind Text <Meta-d> {
  364.     if {!$tk_strictMotif} {
  365.     %W delete insert [tk::TextNextWord %W insert]
  366.     }
  367. }
  368. bind Text <Meta-f> {
  369.     if {!$tk_strictMotif} {
  370.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  371.     }
  372. }
  373. bind Text <Meta-less> {
  374.     if {!$tk_strictMotif} {
  375.     tk::TextSetCursor %W 1.0
  376.     }
  377. }
  378. bind Text <Meta-greater> {
  379.     if {!$tk_strictMotif} {
  380.     tk::TextSetCursor %W end-1c
  381.     }
  382. }
  383. bind Text <Meta-BackSpace> {
  384.     if {!$tk_strictMotif} {
  385.     %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  386.     }
  387. }
  388. bind Text <Meta-Delete> {
  389.     if {!$tk_strictMotif} {
  390.     %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  391.     }
  392. }
  393.  
  394. # Macintosh only bindings:
  395.  
  396. if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
  397. bind Text <FocusIn> {
  398.     %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
  399. }
  400. bind Text <FocusOut> {
  401.     %W configure -selectbackground systemHighlightSecondary -selectforeground systemHighlightText
  402. }
  403. bind Text <Option-Left> {
  404.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  405. }
  406. bind Text <Option-Right> {
  407.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  408. }
  409. bind Text <Option-Up> {
  410.     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  411. }
  412. bind Text <Option-Down> {
  413.     tk::TextSetCursor %W [tk::TextNextPara %W insert]
  414. }
  415. bind Text <Shift-Option-Left> {
  416.     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  417. }
  418. bind Text <Shift-Option-Right> {
  419.     tk::TextKeySelect %W [tk::TextNextWord %W insert]
  420. }
  421. bind Text <Shift-Option-Up> {
  422.     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  423. }
  424. bind Text <Shift-Option-Down> {
  425.     tk::TextKeySelect %W [tk::TextNextPara %W insert]
  426. }
  427.  
  428. # End of Mac only bindings
  429. }
  430.  
  431. # A few additional bindings of my own.
  432.  
  433. bind Text <Control-h> {
  434.     if {!$tk_strictMotif} {
  435.     if {[%W compare insert != 1.0]} {
  436.         %W delete insert-1c
  437.         %W see insert
  438.     }
  439.     }
  440. }
  441. bind Text <2> {
  442.     if {!$tk_strictMotif} {
  443.     tk::TextScanMark %W %x %y
  444.     }
  445. }
  446. bind Text <B2-Motion> {
  447.     if {!$tk_strictMotif} {
  448.     tk::TextScanDrag %W %x %y
  449.     }
  450. }
  451. set ::tk::Priv(prevPos) {}
  452.  
  453. # The MouseWheel will typically only fire on Windows and MacOS X.
  454. # However, someone could use the "event generate" command to produce
  455. # one on other platforms.
  456.  
  457. if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
  458.     bind Text <MouseWheel> {
  459.         %W yview scroll [expr {- (%D)}] units
  460.     }
  461.     bind Text <Option-MouseWheel> {
  462.         %W yview scroll [expr {-10 * (%D)}] units
  463.     }
  464.     bind Text <Shift-MouseWheel> {
  465.         %W xview scroll [expr {- (%D)}] units
  466.     }
  467.     bind Text <Shift-Option-MouseWheel> {
  468.         %W xview scroll [expr {-10 * (%D)}] units
  469.     }
  470. } else {
  471.     bind Text <MouseWheel> {
  472.         %W yview scroll [expr {- (%D / 120) * 4}] units
  473.     }
  474. }
  475.  
  476. if {"x11" eq [tk windowingsystem]} {
  477.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  478.     # the wheel to the extended buttons.  If you have a mousewheel, find
  479.     # Linux configuration info at:
  480.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  481.     bind Text <4> {
  482.     if {!$tk_strictMotif} {
  483.         %W yview scroll -5 units
  484.     }
  485.     }
  486.     bind Text <5> {
  487.     if {!$tk_strictMotif} {
  488.         %W yview scroll 5 units
  489.     }
  490.     }
  491. }
  492.  
  493. # ::tk::TextClosestGap --
  494. # Given x and y coordinates, this procedure finds the closest boundary
  495. # between characters to the given coordinates and returns the index
  496. # of the character just after the boundary.
  497. #
  498. # Arguments:
  499. # w -        The text window.
  500. # x -        X-coordinate within the window.
  501. # y -        Y-coordinate within the window.
  502.  
  503. proc ::tk::TextClosestGap {w x y} {
  504.     set pos [$w index @$x,$y]
  505.     set bbox [$w bbox $pos]
  506.     if {$bbox eq ""} {
  507.     return $pos
  508.     }
  509.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  510.     return $pos
  511.     }
  512.     $w index "$pos + 1 char"
  513. }
  514.  
  515. # ::tk::TextButton1 --
  516. # This procedure is invoked to handle button-1 presses in text
  517. # widgets.  It moves the insertion cursor, sets the selection anchor,
  518. # and claims the input focus.
  519. #
  520. # Arguments:
  521. # w -        The text window in which the button was pressed.
  522. # x -        The x-coordinate of the button press.
  523. # y -        The x-coordinate of the button press.
  524.  
  525. proc ::tk::TextButton1 {w x y} {
  526.     variable ::tk::Priv
  527.  
  528.     set Priv(selectMode) char
  529.     set Priv(mouseMoved) 0
  530.     set Priv(pressX) $x
  531.     $w mark set insert [TextClosestGap $w $x $y]
  532.     $w mark set anchor insert
  533.     # Allow focus in any case on Windows, because that will let the
  534.     # selection be displayed even for state disabled text widgets.
  535.     if {$::tcl_platform(platform) eq "windows" || [$w cget -state] eq "normal"} {focus $w}
  536.     if {[$w cget -autoseparators]} {$w edit separator}
  537. }
  538.  
  539. # ::tk::TextSelectTo --
  540. # This procedure is invoked to extend the selection, typically when
  541. # dragging it with the mouse.  Depending on the selection mode (character,
  542. # word, line) it selects in different-sized units.  This procedure
  543. # ignores mouse motions initially until the mouse has moved from
  544. # one character to another or until there have been multiple clicks.
  545. #
  546. # Arguments:
  547. # w -        The text window in which the button was pressed.
  548. # x -        Mouse x position.
  549. # y -         Mouse y position.
  550.  
  551. proc ::tk::TextSelectTo {w x y {extend 0}} {
  552.     global tcl_platform
  553.     variable ::tk::Priv
  554.  
  555.     set cur [TextClosestGap $w $x $y]
  556.     if {[catch {$w index anchor}]} {
  557.     $w mark set anchor $cur
  558.     }
  559.     set anchor [$w index anchor]
  560.     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
  561.     set Priv(mouseMoved) 1
  562.     }
  563.     switch $Priv(selectMode) {
  564.     char {
  565.         if {[$w compare $cur < anchor]} {
  566.         set first $cur
  567.         set last anchor
  568.         } else {
  569.         set first anchor
  570.         set last $cur
  571.         }
  572.     }
  573.     word {
  574.         if {[$w compare $cur < anchor]} {
  575.         set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
  576.         if { !$extend } {
  577.             set last [TextNextPos $w "anchor" tcl_wordBreakAfter]
  578.         } else {
  579.             set last anchor
  580.         }
  581.         } else {
  582.         set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
  583.         if { !$extend } {
  584.             set first [TextPrevPos $w anchor tcl_wordBreakBefore]
  585.         } else {
  586.             set first anchor
  587.         }
  588.         }
  589.     }
  590.     line {
  591.         if {[$w compare $cur < anchor]} {
  592.         set first [$w index "$cur linestart"]
  593.         set last [$w index "anchor - 1c lineend + 1c"]
  594.         } else {
  595.         set first [$w index "anchor linestart"]
  596.         set last [$w index "$cur lineend + 1c"]
  597.         }
  598.     }
  599.     }
  600.     if {$Priv(mouseMoved) || $Priv(selectMode) ne "char"} {
  601.     $w tag remove sel 0.0 end
  602.     $w mark set insert $cur
  603.     $w tag add sel $first $last
  604.     $w tag remove sel $last end
  605.     update idletasks
  606.     }
  607. }
  608.  
  609. # ::tk::TextKeyExtend --
  610. # This procedure handles extending the selection from the keyboard,
  611. # where the point to extend to is really the boundary between two
  612. # characters rather than a particular character.
  613. #
  614. # Arguments:
  615. # w -        The text window.
  616. # index -    The point to which the selection is to be extended.
  617.  
  618. proc ::tk::TextKeyExtend {w index} {
  619.  
  620.     set cur [$w index $index]
  621.     if {[catch {$w index anchor}]} {
  622.     $w mark set anchor $cur
  623.     }
  624.     set anchor [$w index anchor]
  625.     if {[$w compare $cur < anchor]} {
  626.     set first $cur
  627.     set last anchor
  628.     } else {
  629.     set first anchor
  630.     set last $cur
  631.     }
  632.     $w tag remove sel 0.0 $first
  633.     $w tag add sel $first $last
  634.     $w tag remove sel $last end
  635. }
  636.  
  637. # ::tk::TextPasteSelection --
  638. # This procedure sets the insertion cursor to the mouse position,
  639. # inserts the selection, and sets the focus to the window.
  640. #
  641. # Arguments:
  642. # w -        The text window.
  643. # x, y -     Position of the mouse.
  644.  
  645. proc ::tk::TextPasteSelection {w x y} {
  646.     $w mark set insert [TextClosestGap $w $x $y]
  647.     if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
  648.     set oldSeparator [$w cget -autoseparators]
  649.     if {$oldSeparator} {
  650.         $w configure -autoseparators 0
  651.         $w edit separator
  652.     }
  653.     $w insert insert $sel
  654.     if {$oldSeparator} {
  655.         $w edit separator
  656.         $w configure -autoseparators 1
  657.     }
  658.     }
  659.     if {[$w cget -state] eq "normal"} {focus $w}
  660. }
  661.  
  662. # ::tk::TextAutoScan --
  663. # This procedure is invoked when the mouse leaves a text window
  664. # with button 1 down.  It scrolls the window up, down, left, or right,
  665. # depending on where the mouse is (this information was saved in
  666. # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
  667. # command so that the window continues to scroll until the mouse
  668. # moves back into the window or the mouse button is released.
  669. #
  670. # Arguments:
  671. # w -        The text window.
  672.  
  673. proc ::tk::TextAutoScan {w} {
  674.     variable ::tk::Priv
  675.     if {![winfo exists $w]} return
  676.     if {$Priv(y) >= [winfo height $w]} {
  677.     $w yview scroll 2 units
  678.     } elseif {$Priv(y) < 0} {
  679.     $w yview scroll -2 units
  680.     } elseif {$Priv(x) >= [winfo width $w]} {
  681.     $w xview scroll 2 units
  682.     } elseif {$Priv(x) < 0} {
  683.     $w xview scroll -2 units
  684.     } else {
  685.     return
  686.     }
  687.     TextSelectTo $w $Priv(x) $Priv(y)
  688.     set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
  689. }
  690.  
  691. # ::tk::TextSetCursor
  692. # Move the insertion cursor to a given position in a text.  Also
  693. # clears the selection, if there is one in the text, and makes sure
  694. # that the insertion cursor is visible.  Also, don't let the insertion
  695. # cursor appear on the dummy last line of the text.
  696. #
  697. # Arguments:
  698. # w -        The text window.
  699. # pos -        The desired new position for the cursor in the window.
  700.  
  701. proc ::tk::TextSetCursor {w pos} {
  702.  
  703.     if {[$w compare $pos == end]} {
  704.     set pos {end - 1 chars}
  705.     }
  706.     $w mark set insert $pos
  707.     $w tag remove sel 1.0 end
  708.     $w see insert
  709.     if {[$w cget -autoseparators]} {$w edit separator}
  710. }
  711.  
  712. # ::tk::TextKeySelect
  713. # This procedure is invoked when stroking out selections using the
  714. # keyboard.  It moves the cursor to a new position, then extends
  715. # the selection to that position.
  716. #
  717. # Arguments:
  718. # w -        The text window.
  719. # new -        A new position for the insertion cursor (the cursor hasn't
  720. #        actually been moved to this position yet).
  721.  
  722. proc ::tk::TextKeySelect {w new} {
  723.  
  724.     if {[$w tag nextrange sel 1.0 end] eq ""} {
  725.     if {[$w compare $new < insert]} {
  726.         $w tag add sel $new insert
  727.     } else {
  728.         $w tag add sel insert $new
  729.     }
  730.     $w mark set anchor insert
  731.     } else {
  732.     if {[$w compare $new < anchor]} {
  733.         set first $new
  734.         set last anchor
  735.     } else {
  736.         set first anchor
  737.         set last $new
  738.     }
  739.     $w tag remove sel 1.0 $first
  740.     $w tag add sel $first $last
  741.     $w tag remove sel $last end
  742.     }
  743.     $w mark set insert $new
  744.     $w see insert
  745.     update idletasks
  746. }
  747.  
  748. # ::tk::TextResetAnchor --
  749. # Set the selection anchor to whichever end is farthest from the
  750. # index argument.  One special trick: if the selection has two or
  751. # fewer characters, just leave the anchor where it is.  In this
  752. # case it doesn't matter which point gets chosen for the anchor,
  753. # and for the things like Shift-Left and Shift-Right this produces
  754. # better behavior when the cursor moves back and forth across the
  755. # anchor.
  756. #
  757. # Arguments:
  758. # w -        The text widget.
  759. # index -    Position at which mouse button was pressed, which determines
  760. #        which end of selection should be used as anchor point.
  761.  
  762. proc ::tk::TextResetAnchor {w index} {
  763.  
  764.     if {[$w tag ranges sel] eq ""} {
  765.     # Don't move the anchor if there is no selection now; this makes
  766.     # the widget behave "correctly" when the user clicks once, then
  767.     # shift-clicks somewhere -- ie, the area between the two clicks will be
  768.     # selected. [Bug: 5929].
  769.     return
  770.     }
  771.     set a [$w index $index]
  772.     set b [$w index sel.first]
  773.     set c [$w index sel.last]
  774.     if {[$w compare $a < $b]} {
  775.     $w mark set anchor sel.last
  776.     return
  777.     }
  778.     if {[$w compare $a > $c]} {
  779.     $w mark set anchor sel.first
  780.     return
  781.     }
  782.     scan $a "%d.%d" lineA chA
  783.     scan $b "%d.%d" lineB chB
  784.     scan $c "%d.%d" lineC chC
  785.     if {$lineB < $lineC+2} {
  786.     set total [string length [$w get $b $c]]
  787.     if {$total <= 2} {
  788.         return
  789.     }
  790.     if {[string length [$w get $b $a]] < ($total/2)} {
  791.         $w mark set anchor sel.last
  792.     } else {
  793.         $w mark set anchor sel.first
  794.     }
  795.     return
  796.     }
  797.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  798.     $w mark set anchor sel.last
  799.     } else {
  800.     $w mark set anchor sel.first
  801.     }
  802. }
  803.  
  804. # ::tk::TextInsert --
  805. # Insert a string into a text at the point of the insertion cursor.
  806. # If there is a selection in the text, and it covers the point of the
  807. # insertion cursor, then delete the selection before inserting.
  808. #
  809. # Arguments:
  810. # w -        The text window in which to insert the string
  811. # s -        The string to insert (usually just a single character)
  812.  
  813. proc ::tk::TextInsert {w s} {
  814.     if {$s eq "" || [$w cget -state] eq "disabled"} {
  815.     return
  816.     }
  817.     set compound 0
  818.     catch {
  819.     if {[$w compare sel.first <= insert] \
  820.         && [$w compare sel.last >= insert]} {
  821.             set oldSeparator [$w cget -autoseparators]
  822.             if { $oldSeparator } {
  823.                 $w configure -autoseparators 0
  824.                 $w edit separator
  825.                 set compound 1
  826.             }
  827.         $w delete sel.first sel.last
  828.     }
  829.     }
  830.     $w insert insert $s
  831.     $w see insert
  832.     if { $compound && $oldSeparator } {
  833.         $w edit separator
  834.         $w configure -autoseparators 1
  835.     }
  836. }
  837.  
  838. # ::tk::TextUpDownLine --
  839. # Returns the index of the character one line above or below the
  840. # insertion cursor.  There are two tricky things here.  First,
  841. # we want to maintain the original column across repeated operations,
  842. # even though some lines that will get passed through don't have
  843. # enough characters to cover the original column.  Second, don't
  844. # try to scroll past the beginning or end of the text.
  845. #
  846. # Arguments:
  847. # w -        The text window in which the cursor is to move.
  848. # n -        The number of lines to move: -1 for up one line,
  849. #        +1 for down one line.
  850.  
  851. proc ::tk::TextUpDownLine {w n} {
  852.     variable ::tk::Priv
  853.  
  854.     set i [$w index insert]
  855.     scan $i "%d.%d" line char
  856.     if {$Priv(prevPos) ne $i} {
  857.     set Priv(char) $char
  858.     }
  859.     set new [$w index [expr {$line + $n}].$Priv(char)]
  860.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  861.     set new $i
  862.     }
  863.     set Priv(prevPos) $new
  864.     return $new
  865. }
  866.  
  867. # ::tk::TextPrevPara --
  868. # Returns the index of the beginning of the paragraph just before a given
  869. # position in the text (the beginning of a paragraph is the first non-blank
  870. # character after a blank line).
  871. #
  872. # Arguments:
  873. # w -        The text window in which the cursor is to move.
  874. # pos -        Position at which to start search.
  875.  
  876. proc ::tk::TextPrevPara {w pos} {
  877.     set pos [$w index "$pos linestart"]
  878.     while {1} {
  879.     if {([$w get "$pos - 1 line"] eq "\n" \
  880.          && [$w get $pos] ne "\n") || $pos eq "1.0"} {
  881.         if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  882.             dummy index]} {
  883.         set pos [$w index "$pos + [lindex $index 0] chars"]
  884.         }
  885.         if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} {
  886.         return $pos
  887.         }
  888.     }
  889.     set pos [$w index "$pos - 1 line"]
  890.     }
  891. }
  892.  
  893. # ::tk::TextNextPara --
  894. # Returns the index of the beginning of the paragraph just after a given
  895. # position in the text (the beginning of a paragraph is the first non-blank
  896. # character after a blank line).
  897. #
  898. # Arguments:
  899. # w -        The text window in which the cursor is to move.
  900. # start -    Position at which to start search.
  901.  
  902. proc ::tk::TextNextPara {w start} {
  903.     set pos [$w index "$start linestart + 1 line"]
  904.     while {[$w get $pos] ne "\n"} {
  905.     if {[$w compare $pos == end]} {
  906.         return [$w index "end - 1c"]
  907.     }
  908.     set pos [$w index "$pos + 1 line"]
  909.     }
  910.     while {[$w get $pos] eq "\n"} {
  911.     set pos [$w index "$pos + 1 line"]
  912.     if {[$w compare $pos == end]} {
  913.         return [$w index "end - 1c"]
  914.     }
  915.     }
  916.     if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  917.         dummy index]} {
  918.     return [$w index "$pos + [lindex $index 0] chars"]
  919.     }
  920.     return $pos
  921. }
  922.  
  923. # ::tk::TextScrollPages --
  924. # This is a utility procedure used in bindings for moving up and down
  925. # pages and possibly extending the selection along the way.  It scrolls
  926. # the view in the widget by the number of pages, and it returns the
  927. # index of the character that is at the same position in the new view
  928. # as the insertion cursor used to be in the old view.
  929. #
  930. # Arguments:
  931. # w -        The text window in which the cursor is to move.
  932. # count -    Number of pages forward to scroll;  may be negative
  933. #        to scroll backwards.
  934.  
  935. proc ::tk::TextScrollPages {w count} {
  936.     set bbox [$w bbox insert]
  937.     $w yview scroll $count pages
  938.     if {$bbox eq ""} {
  939.     return [$w index @[expr {[winfo height $w]/2}],0]
  940.     }
  941.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  942. }
  943.  
  944. # ::tk::TextTranspose --
  945. # This procedure implements the "transpose" function for text widgets.
  946. # It tranposes the characters on either side of the insertion cursor,
  947. # unless the cursor is at the end of the line.  In this case it
  948. # transposes the two characters to the left of the cursor.  In either
  949. # case, the cursor ends up to the right of the transposed characters.
  950. #
  951. # Arguments:
  952. # w -        Text window in which to transpose.
  953.  
  954. proc ::tk::TextTranspose w {
  955.     set pos insert
  956.     if {[$w compare $pos != "$pos lineend"]} {
  957.     set pos [$w index "$pos + 1 char"]
  958.     }
  959.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  960.     if {[$w compare "$pos - 1 char" == 1.0]} {
  961.     return
  962.     }
  963.     # ensure this is seen as an atomic op to undo
  964.     set autosep [$w cget -autoseparators]
  965.     if {$autosep} {
  966.     $w configure -autoseparators 0
  967.     $w edit separator
  968.     }
  969.     $w delete "$pos - 2 char" $pos
  970.     $w insert insert $new
  971.     $w see insert
  972.     if {$autosep} {
  973.     $w edit separator
  974.     $w configure -autoseparators $autosep
  975.     }
  976. }
  977.  
  978. # ::tk_textCopy --
  979. # This procedure copies the selection from a text widget into the
  980. # clipboard.
  981. #
  982. # Arguments:
  983. # w -        Name of a text widget.
  984.  
  985. proc ::tk_textCopy w {
  986.     if {![catch {set data [$w get sel.first sel.last]}]} {
  987.     clipboard clear -displayof $w
  988.     clipboard append -displayof $w $data
  989.     }
  990. }
  991.  
  992. # ::tk_textCut --
  993. # This procedure copies the selection from a text widget into the
  994. # clipboard, then deletes the selection (if it exists in the given
  995. # widget).
  996. #
  997. # Arguments:
  998. # w -        Name of a text widget.
  999.  
  1000. proc ::tk_textCut w {
  1001.     if {![catch {set data [$w get sel.first sel.last]}]} {
  1002.     clipboard clear -displayof $w
  1003.     clipboard append -displayof $w $data
  1004.     $w delete sel.first sel.last
  1005.     }
  1006. }
  1007.  
  1008. # ::tk_textPaste --
  1009. # This procedure pastes the contents of the clipboard to the insertion
  1010. # point in a text widget.
  1011. #
  1012. # Arguments:
  1013. # w -        Name of a text widget.
  1014.  
  1015. proc ::tk_textPaste w {
  1016.     global tcl_platform
  1017.     if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
  1018.     # ensure this is seen as an atomic op to undo
  1019.     set oldSeparator [$w cget -autoseparators]
  1020.     if { $oldSeparator } {
  1021.         $w configure -autoseparators 0
  1022.         $w edit separator
  1023.     }
  1024.     if {[tk windowingsystem] ne "x11"} {
  1025.         catch { $w delete sel.first sel.last }
  1026.     }
  1027.     $w insert insert $sel
  1028.     if { $oldSeparator } {
  1029.         $w edit separator
  1030.         $w configure -autoseparators 1
  1031.     }
  1032.     }
  1033. }
  1034.  
  1035. # ::tk::TextNextWord --
  1036. # Returns the index of the next word position after a given position in the
  1037. # text.  The next word is platform dependent and may be either the next
  1038. # end-of-word position or the next start-of-word position after the next
  1039. # end-of-word position.
  1040. #
  1041. # Arguments:
  1042. # w -        The text window in which the cursor is to move.
  1043. # start -    Position at which to start search.
  1044.  
  1045. if {$tcl_platform(platform) eq "windows"}  {
  1046.     proc ::tk::TextNextWord {w start} {
  1047.     TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
  1048.         tcl_startOfNextWord
  1049.     }
  1050. } else {
  1051.     proc ::tk::TextNextWord {w start} {
  1052.     TextNextPos $w $start tcl_endOfWord
  1053.     }
  1054. }
  1055.  
  1056. # ::tk::TextNextPos --
  1057. # Returns the index of the next position after the given starting
  1058. # position in the text as computed by a specified function.
  1059. #
  1060. # Arguments:
  1061. # w -        The text window in which the cursor is to move.
  1062. # start -    Position at which to start search.
  1063. # op -        Function to use to find next position.
  1064.  
  1065. proc ::tk::TextNextPos {w start op} {
  1066.     set text ""
  1067.     set cur $start
  1068.     while {[$w compare $cur < end]} {
  1069.     set text $text[$w get $cur "$cur lineend + 1c"]
  1070.     set pos [$op $text 0]
  1071.     if {$pos >= 0} {
  1072.         ## Adjust for embedded windows and images
  1073.         ## dump gives us 3 items per window/image
  1074.         set dump [$w dump -image -window $start "$start + $pos c"]
  1075.         if {[llength $dump]} {
  1076.         set pos [expr {$pos + ([llength $dump]/3)}]
  1077.         }
  1078.         return [$w index "$start + $pos c"]
  1079.     }
  1080.     set cur [$w index "$cur lineend +1c"]
  1081.     }
  1082.     return end
  1083. }
  1084.  
  1085. # ::tk::TextPrevPos --
  1086. # Returns the index of the previous position before the given starting
  1087. # position in the text as computed by a specified function.
  1088. #
  1089. # Arguments:
  1090. # w -        The text window in which the cursor is to move.
  1091. # start -    Position at which to start search.
  1092. # op -        Function to use to find next position.
  1093.  
  1094. proc ::tk::TextPrevPos {w start op} {
  1095.     set text ""
  1096.     set cur $start
  1097.     while {[$w compare $cur > 0.0]} {
  1098.     set text [$w get "$cur linestart - 1c" $cur]$text
  1099.     set pos [$op $text end]
  1100.     if {$pos >= 0} {
  1101.         ## Adjust for embedded windows and images
  1102.         ## dump gives us 3 items per window/image
  1103.         set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
  1104.         if {[llength $dump]} {
  1105.         ## This is a hokey extra hack for control-arrow movement
  1106.         ## that should be in a while loop to be correct (hobbs)
  1107.         if {[$w compare [lindex $dump 2] > \
  1108.             "$cur linestart - 1c + $pos c"]} {
  1109.             incr pos -1
  1110.         }
  1111.         set pos [expr {$pos + ([llength $dump]/3)}]
  1112.         }
  1113.         return [$w index "$cur linestart - 1c + $pos c"]
  1114.     }
  1115.     set cur [$w index "$cur linestart - 1c"]
  1116.     }
  1117.     return 0.0
  1118. }
  1119.  
  1120. # ::tk::TextScanMark --
  1121. #
  1122. # Marks the start of a possible scan drag operation
  1123. #
  1124. # Arguments:
  1125. # w -    The text window from which the text to get
  1126. # x -    x location on screen
  1127. # y -    y location on screen
  1128.  
  1129. proc ::tk::TextScanMark {w x y} {
  1130.     $w scan mark $x $y
  1131.     set ::tk::Priv(x) $x
  1132.     set ::tk::Priv(y) $y
  1133.     set ::tk::Priv(mouseMoved) 0
  1134. }
  1135.  
  1136. # ::tk::TextScanDrag --
  1137. #
  1138. # Marks the start of a possible scan drag operation
  1139. #
  1140. # Arguments:
  1141. # w -    The text window from which the text to get
  1142. # x -    x location on screen
  1143. # y -    y location on screen
  1144.  
  1145. proc ::tk::TextScanDrag {w x y} {
  1146.     # Make sure these exist, as some weird situations can trigger the
  1147.     # motion binding without the initial press.  [Bug #220269]
  1148.     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
  1149.     if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y }
  1150.     if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} {
  1151.     set ::tk::Priv(mouseMoved) 1
  1152.     }
  1153.     if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {
  1154.     $w scan dragto $x $y
  1155.     }
  1156. }
  1157.